home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
sortdemo.zip
/
SDDISP.INC
< prev
next >
Wrap
Text File
|
1992-04-15
|
18KB
|
520 lines
(*
╔═══════════════════════════════════════════════════════════════════════════╗
║ Turbo Pascal 6.0 Include File : SDDISP.INC ║
╟───────────────────────────────────────────────────────────────────────────╢
║ Program : SORTDEMO.PAS ║
╟───────────────────────────────────────────────────────────────────────────╢
║ Version : 1.0 ║
╟───────────────────────────────────────────────────────────────────────────╢
║ Copyright (c) 1992 by Jon S. Russell ║
╟───────────────────────────────────────────────────────────────────────────╢
║ Info-display and menuing routines for SORTDEMO.PAS ║
╚═══════════════════════════════════════════════════════════════════════════╝
*)
procedure ShadowText ( Msg : string;
Col1, Col2 : word;
x, y : integer);
var
OldCol : word;
begin (* ShadowText *)
OldCol := GetColor;
SetColor(Col2);
OutTextXY(x-1,y+1,Msg);
SetColor(Col1);
OutTextXY(x,y,Msg);
SetColor(OldCol);
end; (* ShadowText *)
(*─────────────────────────────────────────────────────────────────────────*)
procedure TitleScreen;
begin (* TitleScreen *)
SetTextStyle(SmallFont, HorizDir, 6);
SetTextJustify(CenterText, TopText);
ShadowText('SortDemo', 9,1,160,65);
SetTextStyle(SmallFont, HorizDir, 4);
ShadowText('ver 1.0',9,1,160,85);
SetTextStyle(SmallFont, HorizDir, 3);
ShadowText('by',9,1,160,100);
SetTextStyle(SmallFont, HorizDir, 5);
ShadowText('Jon S. Russell',9,1,160,115);
SetTextStyle(SmallFont, HorizDir, 4);
ShadowText('press any key...',10,2,160,185);
FlushAndWait;
ClearDevice;
end; (* TitleScreen *)
(*─────────────────────────────────────────────────────────────────────────*)
procedure Menu (var Info : InfoType);
var
t : byte;
const
Mx1 = 10; My1 = 30; Sx1 = 10; Sy1 = 160;
Mx2 = 310; My2 = 150; Sx2 = 310; Sy2 = 180;
(*───────────────────────────────────────────────────────────────────────*)
procedure DrawSlider (TopX, TopY, Size, Index : integer);
begin (* DrawSlider *)
SetFillStyle(SolidFill, LightGray);
Bar(TopX, TopY, TopX+10, TopY+Size*10);
FillEllipse(TopX+5, TopY, 5, 2);
FillEllipse(TopX+5, TopY+Size*10, 5, 2);
SetFillStyle(SolidFill, Red);
Bar(TopX+2, TopY+(Index-1)*10+2, TopX+8, TopY+(Index-1)*10+8);
end; (* DrawSlider *)
(*───────────────────────────────────────────────────────────────────────*)
procedure XSizeSlider ( index : word);
begin (* XSizeSlider *)
case index of
20 : DrawSlider(Mx1+10, My1+20, 4, 1);
40 : DrawSlider(Mx1+10, My1+20, 4, 2);
80 : DrawSlider(Mx1+10, My1+20, 4, 3);
160 : DrawSlider(Mx1+10, My1+20, 4, 4);
end; (* case *)
end; (* XSizeSlider *)
(*───────────────────────────────────────────────────────────────────────*)
procedure YSizeSlider ( index : word);
begin (* YSizeSlider *)
case index of
1 : DrawSlider(Mx1+64, My1+20, 9, 1);
2 : DrawSlider(Mx1+64, My1+20, 9, 2);
4 : DrawSlider(Mx1+64, My1+20, 9, 3);
5 : DrawSlider(Mx1+64, My1+20, 9, 4);
8 : DrawSlider(Mx1+64, My1+20, 9, 5);
10 : DrawSlider(Mx1+64, My1+20, 9, 6);
20 : DrawSlider(Mx1+64, My1+20, 9, 7);
25 : DrawSlider(Mx1+64, My1+20, 9, 8);
50 : DrawSlider(Mx1+64, My1+20, 9, 9);
end; (* case *)
end; (* YSizeSlider *)
(*───────────────────────────────────────────────────────────────────────*)
procedure MethodSlider ( index : MethodType);
begin (* MethodSlider *)
DrawSlider(Mx1+110, My1+20, NumTitles, Ord(index)+1);
end; (* MethodSlider *)
(*───────────────────────────────────────────────────────────────────────*)
procedure FileSlider ( index : boolean);
begin (* FileSlider *)
case index of
true : DrawSlider(Mx1+230, My1+20, 2, 1);
false : DrawSlider(Mx1+230, My1+20, 2, 2);
end; (* case *)
end; (* FileSlider *)
(*───────────────────────────────────────────────────────────────────────*)
procedure OperationSlider ( index : OperationType);
begin (* OperationSlider *)
DrawSlider(Mx1+230, My1+70, 3, Ord(index)+1);
end; (* OperationSlider *)
(*───────────────────────────────────────────────────────────────────────*)
procedure ASize ( Len : word);
var
s : string;
begin (* ASize *)
SetFillStyle(SolidFill, Blue);
bar(Sx1+80, Sy1+5, Sx1+120, Sy1+15);
str(Len:5, s);
OutTextXY(Sx1+80, Sy1+5, s);
end; (* ASize *)
(*───────────────────────────────────────────────────────────────────────*)
procedure AStatus ( Sorted : boolean);
var
s : string;
begin (* AStatus *)
SetFillStyle(SolidFill, Blue);
Bar(Sx1+235, Sy1+5, Sx1+290, Sy1+15);
if Sorted
then s := 'sorted '
else s := 'unsorted';
OutTextXY(Sx1+240, Sy1+5, s);
end; (* AStatus *)
(*───────────────────────────────────────────────────────────────────────*)
procedure DoMenu (var Info : InfoType);
type
OpSet = (XSize,YSize,Method,StatFile,Operation);
var
OldOp : OpSet;
NewOp : OpSet;
(*─────────────────────────────────────────────────────────────────────*)
procedure NextOp (var Op : OpSet);
begin (* NextOp *)
if Op <> Operation
then Op := Succ(Op)
else Op := XSize;
end; (* NextOp *)
(*─────────────────────────────────────────────────────────────────────*)
procedure PrevOp (var Op : OpSet);
begin (* PrevOp *)
if Op <> XSize
then Op := Pred(Op)
else Op := Operation;
end; (* PrevOp *)
(*─────────────────────────────────────────────────────────────────────*)
procedure HighLight ( OldOp, NewOp : OpSet);
begin (* HighLight *)
case OldOp of
XSize : ShadowText('X-size', LightGray,Blue,Mx1+ 10,My1+ 5);
YSize : ShadowText('Y-size', LightGray,Blue,Mx1+ 60,My1+ 5);
Method : ShadowText('Method', LightGray,Blue,Mx1+110,My1+ 5);
StatFile : ShadowText('Stats file',LightGray,Blue,Mx1+230,My1+ 5);
Operation : ShadowText('Operation', LightGray,Blue,Mx1+230,My1+55);
end; (* case *)
case NewOp of
XSize : ShadowText('X-size', White,DarkGray,Mx1+ 10,My1+ 5);
YSize : ShadowText('Y-size', White,DarkGray,Mx1+ 60,My1+ 5);
Method : ShadowText('Method', White,DarkGray,Mx1+110,My1+ 5);
StatFile : ShadowText('Stats file',White,DarkGray,Mx1+230,My1+ 5);
Operation : ShadowText('Operation', White,DarkGray,Mx1+230,My1+55);
end; (* case *)
end; (* HighLight *)
(*─────────────────────────────────────────────────────────────────────*)
procedure DecSet (var Info : InfoType;
Op : OpSet);
begin (* DecSet *)
case Op of
XSize : begin
case Info.xElems of
20 : Info.xElems := 160;
40 : Info.xElems := 20;
80 : Info.xElems := 40;
160 : Info.xElems := 80;
end; (* case *)
XSizeSlider(Info.xElems);
Info.Len := Info.xElems*Info.yElems;
LoadArray(Info);
ASize(Info.Len);
AStatus(Info.Sorted);
end;
YSize : begin
case Info.yElems of
1 : Info.yElems := 50;
2 : Info.yElems := 1;
4 : Info.yElems := 2;
5 : Info.yElems := 4;
8 : Info.yElems := 5;
10 : Info.yElems := 8;
20 : Info.yElems := 10;
25 : Info.yElems := 20;
50 : Info.yElems := 25;
end; (* case *)
YSizeSlider(Info.yElems);
Info.Len := Info.xElems*Info.yElems;
LoadArray(Info);
ASize(Info.Len);
AStatus(Info.Sorted);
end;
Method : begin
if Info.Method <> Bubble
then Info.Method := pred(Info.Method)
else Info.Method := Heap;
MethodSlider(Info.Method);
end;
StatFile : begin
if Info.Save
then Info.Save := false
else Info.Save := true;
FileSlider(Info.Save);
end;
Operation : begin
if Info.Operation <> Mix
then Info.Operation := pred(Info.Operation)
else Info.Operation := Quit;
OperationSlider(Info.Operation);
end;
end; (* case *)
end; (* DecSet *)
(*─────────────────────────────────────────────────────────────────────*)
procedure IncSet (var Info : InfoType;
Op : OpSet);
begin (* IncSet *)
case Op of
XSize : begin
case Info.xElems of
20 : Info.xElems := 40;
40 : Info.xElems := 80;
80 : Info.xElems := 160;
160 : Info.xElems := 20;
end; (* case *)
XSizeSlider(Info.xElems);
Info.len := Info.xElems*Info.yElems;
LoadArray(Info);
ASize(Info.Len);
AStatus(Info.Sorted);
end;
YSize : begin
case Info.yElems of
1 : Info.yElems := 2;
2 : Info.yElems := 4;
4 : Info.yElems := 5;
5 : Info.yElems := 8;
8 : Info.yElems := 10;
10 : Info.yElems := 20;
20 : Info.yElems := 25;
25 : Info.yElems := 50;
50 : Info.yElems := 1;
end; (* case *)
YSizeSlider(Info.yElems);
Info.Len := Info.xElems*Info.yElems;
LoadArray(Info);
ASize(Info.Len);
AStatus(Info.Sorted);
end;
Method : begin
if Info.Method <> Heap
then Info.Method := succ(Info.Method)
else Info.Method := Bubble;
MethodSlider(Info.Method);
end;
StatFile : begin
if Info.Save
then Info.Save := false
else Info.Save := true;
FileSlider(Info.Save);
end;
Operation : begin
if Info.Operation <> Quit
then Info.Operation := succ(Info.Operation)
else Info.Operation := Mix;
OperationSlider(Info.Operation);
end;
end; (* case *)
end; (* IncSet *)
(*─────────────────────────────────────────────────────────────────────*)
begin (* DoMenu *)
OldOp := Operation;
NewOp := Operation;
HighLight (OldOp, NewOp);
FlushKeyBuffer;
repeat
GetKey(KeyRec);
if KeyRec.Extended
then
begin
case KeyRec.Ch of
LfArrowKey : PrevOp(NewOp);
RtArrowKey : NextOp(NewOp);
UpArrowKey : DecSet(Info, NewOp);
DnArrowKey : IncSet(Info, NewOp);
end; (* case *)
end
else
begin
case KeyRec.Ch of
'x','X' : NewOp := XSize;
'y','Y' : NewOp := YSize;
'm','M' : NewOp := Method;
's','S' : NewOp := StatFile;
'o','O' : NewOp := Operation;
end; (* case *)
end;
if OldOp <> NewOp then Highlight(OldOp, NewOp);
OldOp := NewOp;
until ((KeyRec.Extended = false) and (KeyRec.Ch = EnterKey));
end; (* DoMenu *)
(*───────────────────────────────────────────────────────────────────────*)
begin (* Menu *)
ClearDevice;
DrawPanel(Mx1,My1,Mx2,My2, Blue, LightGray, DarkGray, 2);
DrawPanel(Sx1,Sy1,Sx2,Sy2, Blue, LightGray, DarkGray, 2);
SetTextStyle(SmallFont, HorizDir, 4);
SetTextJustify(LeftText, TopText);
SetColor(LightGray);
OutTextXY(Mx1+10, My1+ 5, 'X-size');
OutTextXY(Mx1+27, My1+20, ' 20');
OutTextXY(Mx1+27, My1+30, ' 40');
OutTextXY(Mx1+27, My1+40, ' 80');
OutTextXY(Mx1+27, My1+50, '160');
XSizeSlider(Info.xElems);
OutTextXY(Mx1+60, My1+ 5, 'Y-size');
OutTextXY(Mx1+77, My1+ 20, ' 1');
OutTextXY(Mx1+77, My1+ 30, ' 2');
OutTextXY(Mx1+77, My1+ 40, ' 4');
OutTextXY(Mx1+77, My1+ 50, ' 5');
OutTextXY(Mx1+77, My1+ 60, ' 8');
OutTextXY(Mx1+77, My1+ 70, ' 10');
OutTextXY(Mx1+77, My1+ 80, ' 20');
OutTextXY(Mx1+77, My1+ 90, ' 25');
OutTextXY(Mx1+77, My1+100, ' 50');
YSizeSlider(Info.yElems);
OutTextXY(Mx1+110, My1+ 5, 'Method');
for t := 1 to NumTitles do
OutTextXY(Mx1+127, My1+10+t*10, SortTitles[t]);
MethodSlider(Info.Method);
OutTextXY(Mx1+230, My1+5, 'Stats file');
OutTextXY(Mx1+245, My1+20, 'yes');
OutTextXY(Mx1+245, My1+30, 'no');
FileSlider(Info.Save);
OutTextXY(Mx1+230, My1+55, 'Operation');
OutTextXY(Mx1+245, My1+70, 'mix');
OutTextXY(Mx1+245, My1+80, 'sort');
OutTextXY(Mx1+245, My1+90, 'quit');
OperationSlider(Info.Operation);
OutTextXY(Sx1+10, Sy1+5, 'Array-size:');
ASize(Info.Len);
OutTextXY(Sx1+160, Sy1+5, 'Array-status:');
AStatus(Info.Sorted);
DoMenu(Info);
end; (* Menu *)
(*─────────────────────────────────────────────────────────────────────────*)
procedure ShowAnalysis (var Info : InfoType;
Start : TimeDateType;
Stop : TimeDateType;
Diff : DiffType);
const
Ax1 = 20; Ax2 = 300;
Ay1 = 30; Ay2 = 170;
var
s1, s2 : string;
(*───────────────────────────────────────────────────────────────────────*)
function Num2Str ( Num : integer;
Digits : byte;
Fill : boolean) : string;
var
S : string;
begin (* Num2Str *)
str(Num:Digits, S);
if Fill then
while (pos(' ',S) > 0) do
S[pos(' ',S)] := '0';
Num2Str := S;
end; (* Num2Str *)
(*───────────────────────────────────────────────────────────────────────*)
begin (* ShowAnalysis *)
ClearDevice;
DrawPanel(Ax1,Ay1,Ax2,Ay2, Blue, LightGray, DarkGray, 2);
SetTextStyle(SmallFont, HorizDir, 7);
SetTextJustify(CenterText, TopText);
ShadowText('Analysis', LightRed, Red, 160, Ay1+5);
SetTextStyle(SmallFont, HorizDir, 4);
SetTextJustify(LeftText, TopText);
s1 := 'Sort method: ';
s2 := SortTitles[Ord(Info.Method)+1];
SetColor(LightGray);
OutTextXY(Ax1+10, Ay1+30, s1);
SetColor(White);
OutTextXY(Ax1+10+TextWidth(s1), Ay1+30, s2);
s1 := 'Array size: [';
s2 := Num2Str(Info.xElems, 3, false);
SetColor(LightGray);
OutTextXY(Ax1+10, Ay1+50, s1);
SetColor(White);
OutTextXY(Ax1+10+TextWidth(s1), Ay1+50, s2);
s1 := s1 + s2;
s2 := ',';
SetColor(LightGray);
OutTextXY(Ax1+10+TextWidth(s1), Ay1+50, s2);
s1 := s1 + s2;
s2 := Num2Str(Info.yElems, 3, false);
SetColor(White);
OutTextXY(Ax1+10+TextWidth(s1), Ay1+50, s2);
s1 := s1 + s2;
s2 := '] = ';
SetColor(LightGray);
OutTextXY(Ax1+10+TextWidth(s1), Ay1+50, s2);
s1 := s1 + s2;
s2 := Num2Str(Info.Len, 4, false);
SetColor(White);
OutTextXY(Ax1+10+TextWidth(s1), Ay1+50, s2);
s1 := s1 + s2;
s2 := ' elements';
SetColor(LightGray);
OutTextXY(Ax1+10+TextWidth(s1), Ay1+50, s2);
SetTextJustify(LeftText, TopText);
SetColor(LightGray);
OutTextXY(Ax1+5, Ay1+70, 'Start time:');
OutTextXY(Ax1+5, Ay1+80, 'Stop time:');
SetTextJustify(RightText, TopText);
SetColor(White);
OutTextXY(Ax2-10, Ay1+70, TimeDate2Str(Start));
OutTextXY(Ax2-10, Ay1+80, TimeDate2Str(Stop));
SetTextJustify(LeftText, TopText);
SetColor(LightGray);
OutTextXY(Ax1+5, Ay1+95, 'Sort time...');
SetTextJustify(RightText, TopText);
OutTextXY(Ax1+120, Ay1+95, 'Days');
OutTextXY(Ax1+155, Ay1+95, 'Hrs');
OutTextXY(Ax1+190, Ay1+95, 'Mins');
OutTextXY(Ax1+225, Ay1+95, 'Secs');
OutTextXY(Ax1+260, Ay1+95, '100s');
SetColor(White);
OutTextXY(Ax1+120, Ay1+105, Num2Str(Diff.Days, 2, false));
OutTextXY(Ax1+155, Ay1+105, Num2Str(Diff.Hours, 2, true));
OutTextXY(Ax1+190, Ay1+105, Num2Str(Diff.Minutes, 2, true));
OutTextXY(Ax1+225, Ay1+105, Num2Str(Diff.Seconds, 2, true));
OutTextXY(Ax1+260, Ay1+105, Num2Str(Diff.Sec100s, 2, true));
if Info.Save then AnalysisToFile(Info, Start, Stop, Diff);
SetTextJustify(CenterText, TopText);
ShadowText('press any key to continue', LightGreen, Green, 160, Ay2-15);
FlushAndWait;
end; (* ShowAnalysis *)
(*─────────────────────────────────────────────────────────────────────────*)